home *** CD-ROM | disk | FTP | other *** search
/ Garden Fax: Fruits, Vegetables & Herbs / Garden Fax - Fruits, Vegetables & Herbs (1991)(CDTV Publishing)[!].iso / system / basicdemos / loadacbm < prev    next >
Text File  |  1978-01-06  |  9KB  |  391 lines
  1. REM - LoadACBM
  2. REM -  by Carolyn Scheppner  CBM  04/86
  3.  
  4. REM -  Modified for PAL/NTSC  07/87
  5. REM -  NOTE:  Only PAL ACBMs will be
  6. REM -    displayed in a PAL height
  7. REM -    screen.  PAL ACBM's contain
  8. REM -    a PAL screenheight in their
  9. REM -    BMHD pageHeight field
  10.  
  11. REM - This program loads an ACBM file
  12. REM -  (Amiga Contiguous BitMap)
  13. REM -  into a custom screen/window
  14. REM -  using DOS library calls
  15. REM - 
  16. REM - Note that the only special chunk
  17. REM -  handled by this loader is the
  18. REM -  CCRT Graphicraft color cycling
  19. REM -  chunk.  The loader is an IFF
  20. REM -  chunk-oriented loader and
  21. REM -  can be easily modified to
  22. REM -  handle additional chunks.
  23.  
  24. REM - Requires exec, graphics and dos
  25. REM -  .bmaps (Use new ConvertFD)
  26. REM
  27.  
  28. REM - Format of ACBM file:
  29. REM -    LONG   "FORM"
  30. REM -    LONG   size of rest of file
  31. REM -    LONG   "ACBM" (form type)
  32. REM 
  33. REM -    LONG   "BMHD" (std IFF BitMap header)
  34. REM -    LONG   size of BMHD chunk = 20
  35. REM -    UWORD  w (bitmap width in pixels)
  36. REM -    UWORD  h (bitmap height)
  37. REM -    WORD   x (nw corner) = 0
  38. REM -    WORD   y (nw corner) = 0
  39. REM -    UBYTE  nPlanes
  40. REM -    UBYTE  masking = 0
  41. REM -    UBYTE  compression = 0
  42. REM -    UBYTE  pad1 = 0
  43. REM -    UWORD  transparentColor = 0
  44. REM -    UBYTE  xAspect (pixel) = 10
  45. REM -    UBYTE  yAspect (pixel) = 11
  46. REM -    WORD   pageWidth (screen width in pixels)    
  47. REM -    WORD   pageHeight (screen height in pixels)
  48. REM 
  49. REM -    LONG   "CMAP" (std IFF ColorMap chunk)
  50. REM -    LONG   size of CMAP chunk
  51. REM -    UBYTE  Sets of 3 UBYTES (red, green, blue)
  52. REM -           (2^nPlanes sets)
  53. REM -           (rgb values LEFT justified in each UBYTE)
  54. REM
  55. REM -    LONG   "CAMG" (Amiga ViewPort Modes)
  56. REM -    LONG   size of CAMG chunk
  57. REM -    LONG   ViewModes
  58. REM
  59. REM -    LONG   "CCRT"  (Graphicraft color cycle info)
  60. REM -    WORD   direction (1,-1, or 0 = none)
  61. REM -    UBYTE  start  (low cycle reg)
  62. REM -    UBYTE  end    (high cycle reg)
  63. REM -    LONG   seconds (cycle time)
  64. REM -    LONG   microseconds (cycle time)
  65. REM -    WORD   pad = 0
  66. REM
  67. REM -    LONG   "ABIT"  (Amiga BitPlanes)
  68. REM -    LONG   size of ABIT chunk
  69. REM -           BitPlanes 0 thru nPlanes - 1
  70. REM -          (each is h * (w/8) bytes)
  71.  
  72.  
  73. Main:
  74.  
  75. PRINT "LoadACBM - ACBM pic file loader"
  76. PRINT
  77. PRINT " This program loads and displays an ACBM pic file."
  78. PRINT "ACBM pic files can be loaded more quickly than ILBMs."
  79. PRINT "IFF ILBM pic files can be converted to ACBM format"
  80. PRINT "with the LoadILBM-SaveACBM program."
  81. PRINT
  82.  
  83. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  84.  
  85. REM - Functions from dos.library                   
  86. DECLARE FUNCTION xOpen&  LIBRARY
  87. DECLARE FUNCTION xRead&  LIBRARY
  88. DECLARE FUNCTION xWrite& LIBRARY
  89. REM - xClose returns no value
  90.  
  91. REM - Functions from exec.library
  92. DECLARE FUNCTION AllocMem&() LIBRARY
  93. REM - FreeMem returns no value
  94.  
  95. PRINT:PRINT "Looking for bmaps ... ";
  96. LIBRARY "dos.library"
  97. LIBRARY "exec.library"
  98. LIBRARY "graphics.library"
  99. PRINT "found them."
  100.  
  101. PRINT:PRINT "ENTER FILESPEC:"
  102. PRINT "( Note: You can create an ACBM file with LoadILBM-SaveACBM )"
  103. PRINT
  104. GetNames:
  105. INPUT "   ACBM filespec";ACBMname$
  106. IF (ACBMname$ = "") GOTO Mcleanup2
  107. PRINT
  108.  
  109. REM - Load the ACBM pic
  110. loadError$ = ""
  111. GOSUB LoadACBM
  112. IF loadError$ <> "" THEN GOTO Mcleanup
  113.  
  114. REM - Demo Graphicraft color cycling
  115. IF foundCCRT AND ccrtDir% THEN
  116.    REM - Save colors
  117.    FOR kk = 0 TO nColors% -1
  118.       cTabSave%(kk) = PEEKW(colorTab&+(kk*2))   
  119.       cTabWork%(kk) = cTabSave%(kk)
  120.    NEXT
  121.    
  122.    REM - Cycle colors
  123.    FOR kk = 0 TO 80
  124.       IF ccrtDir% = 1 THEN
  125.          GOSUB Fcycle
  126.       ELSE   
  127.          GOSUB Bcycle
  128.       END IF
  129.  
  130.       CALL LoadRGB4&(sViewPort&,VARPTR(cTabWork%(0)),nColors%)
  131.       REM - Delays approximated
  132.       FOR de1 = 0 TO ccrtSecs& * 3000
  133.          FOR de2 = 0 TO ccrtMics& / 500
  134.          NEXT
  135.       NEXT
  136.    NEXT
  137.  
  138.    REM - Restore colors
  139.    CALL LoadRGB4&(sViewPort&,VARPTR(cTabSave%(0)),nColors%)
  140. END IF
  141.  
  142. Mcleanup:
  143. FOR de = 1 TO 20000:NEXT
  144. WINDOW CLOSE 2
  145. SCREEN CLOSE 2
  146.  
  147. Mcleanup2:
  148. LIBRARY CLOSE
  149. IF loadError$ <> "" THEN PRINT loadError$
  150. END
  151.  
  152.  
  153. Bcycle:  'Backward color cycle
  154. cTemp% = cTabWork%(ccrtEnd%)
  155. FOR jj = ccrtEnd%-1 TO ccrtStart% STEP -1
  156.    cTabWork%(jj+1) = cTabWork%(jj)
  157. NEXT
  158. cTabWork%(ccrtStart%) = cTemp%
  159. RETURN
  160.  
  161. Fcycle:  'Forward color cycle
  162. cTemp% = cTabWork%(ccrtStart%)
  163. FOR jj = ccrtStart%+1 TO ccrtEnd%
  164.    cTabWork%(jj-1) = cTabWork%(jj)
  165. NEXT
  166. cTabWork%(ccrtEnd%) = cTemp%
  167. RETURN
  168.  
  169.  
  170. LoadACBM:
  171. REM - Requires the following variables
  172. REM - to have been initialized:
  173. REM -    ACBMname$ (ACBM filespec)
  174.  
  175. REM - init variables
  176. f$ = ACBMname$
  177. fHandle& = 0
  178. mybuf& = 0
  179. foundBMHD = 0
  180. foundCMAP = 0
  181. foundCamg = 0
  182. foundCCRT = 0
  183. foundABIT = 0
  184.  
  185. REM - From include/libraries/dos.h
  186. REM - MODE_NEWFILE = 1006 
  187. REM - MODE_OLDFILE = 1005
  188.  
  189. filename$ = f$ + CHR$(0)
  190. fHandle& = xOpen&(SADD(filename$),1005)
  191. IF fHandle& = 0 THEN
  192.    loadError$ = "Can't open/find pic file"
  193.    GOTO Lcleanup
  194. END IF
  195.  
  196.  
  197. REM - Alloc ram for work buffers
  198. ClearPublic& = 65537&
  199. mybufsize& = 360
  200. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  201. IF mybuf& = 0 THEN
  202.    loadError$ = "Can't alloc buffer"
  203.    GOTO Lcleanup
  204. END IF
  205.  
  206. inbuf& = mybuf&
  207. cbuf& = mybuf& + 120
  208. ctab& = mybuf& + 240
  209.  
  210.  
  211. REM - Should read  FORMnnnnACBM
  212. rLen& = xRead&(fHandle&,inbuf&,12)
  213. tt$ = ""
  214. FOR kk = 8 TO 11
  215.    tt% = PEEK(inbuf& + kk)
  216.    tt$ = tt$ + CHR$(tt%)
  217. NEXT
  218.  
  219. IF tt$ <> "ACBM" THEN 
  220.    loadError$ = "Not an ACBM pic file"
  221.    GOTO Lcleanup
  222. END IF
  223.  
  224. REM - Read ACBM chunks
  225.  
  226. ChunkLoop:
  227. REM - Get Chunk name/length
  228.  rLen& = xRead&(fHandle&,inbuf&,8)
  229.  icLen& = PEEKL(inbuf& + 4)
  230.  tt$ = ""
  231.  FOR kk = 0 TO 3
  232.     tt% = PEEK(inbuf& + kk)
  233.     tt$ = tt$ + CHR$(tt%)
  234.  NEXT   
  235.     
  236. IF tt$ = "BMHD" THEN  'BitMap header 
  237.    foundBMHD = 1
  238.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  239.    iWidth%  = PEEKW(inbuf&)
  240.    iHeight% = PEEKW(inbuf& + 2)
  241.    iDepth%  = PEEK(inbuf& + 8)  
  242.    iCompr%  = PEEK(inbuf& + 10)
  243.    scrWidth%  = PEEKW(inbuf& + 16)
  244.    scrHeight% = PEEKW(inbuf& + 18)
  245.  
  246.    iRowBytes% = iWidth% /8
  247.    scrRowBytes% = scrWidth% / 8
  248.    nColors%  = 2^(iDepth%)
  249.  
  250.    REM - Enough free ram to display ?
  251.    AvailRam& = FRE(-1)
  252.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  253.    IF AvailRam& < NeededRam& THEN
  254.       loadError$ = "Not enough free ram."
  255.       GOTO Lcleanup
  256.    END IF
  257.  
  258.    hires& = &H8000
  259.    lace&  = &H4
  260.    kk = 1
  261.    IF foundCamg THEN
  262.       IF (camgModes& AND hires&) THEN kk = kk+1
  263.       IF (camgModes& AND lace&)  THEN kk = kk+2
  264.    ELSE   
  265.       IF scrWidth% >= 640 THEN kk = kk + 1
  266.       IF scrHeight% >= 400 THEN kk = kk + 2
  267.    END IF
  268.    
  269.    SCREEN 2,scrWidth%,scrHeight%,iDepth%,kk
  270.    WINDOW 2,"LoadACBM",,7,2
  271.  
  272.    REM - Get addresses of structures
  273.    GOSUB GetScrAddrs
  274.  
  275.    REM - Black out screen
  276.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  277.  
  278.  
  279. ELSEIF tt$ = "CMAP" THEN  'ColorMap
  280.    foundCMAP = 1
  281.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  282.  
  283.    REM - Build Color Table
  284.    FOR kk = 0 TO nColors% - 1
  285.       red% = PEEK(cbuf&+(kk*3))
  286.       gre% = PEEK(cbuf&+(kk*3)+1)
  287.       blu% = PEEK(cbuf&+(kk*3)+2)
  288.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  289.       POKEW(ctab&+(2*kk)),regTemp%
  290.    NEXT
  291.  
  292.  
  293. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  294.    foundCamg = 1
  295.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  296.    camgModes& = PEEKL(inbuf&)
  297.  
  298.  
  299. ELSEIF tt$ = "CCRT" THEN 'Graphicraft color cycle info
  300.    foundCCRT = 1
  301.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  302.    ccrtDir%    = PEEKW(inbuf&)
  303.    ccrtStart%  = PEEK(inbuf& + 2)
  304.    ccrtEnd%    = PEEK(inbuf& + 3)
  305.    ccrtSecs&   = PEEKL(inbuf& + 4)
  306.    ccrtMics&   = PEEKL(inbuf& + 8)
  307.  
  308.  
  309. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  310.    foundABIT = 1
  311.  
  312.    REM - This only handles full size BitMaps, not brushes
  313.    REM - Very fast - reads in entire BitPlanes
  314.    plSize& = (scrWidth%/8) * scrHeight%
  315.    FOR pp = 0 TO iDepth% -1
  316.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  317.    NEXT
  318.  
  319.  
  320. ELSE 
  321.    REM - Reading unknown chunk  
  322.    FOR kk = 1 TO icLen&
  323.       rLen& = xRead&(fHandle&,inbuf&,1)
  324.    NEXT
  325.    REM - If odd length, read 1 more byte
  326.    IF (icLen& OR 1) = icLen& THEN 
  327.       rLen& = xRead&(fHandle&,inbuf&,1)
  328.    END IF
  329.       
  330. END IF
  331.  
  332.  
  333. REM - Done if got all chunks 
  334. IF foundBMHD AND foundCMAP AND foundABIT THEN
  335.    GOTO GoodLoad
  336. END IF
  337.  
  338. REM - Good read, get next chunk
  339. IF rLen& > 0 THEN GOTO ChunkLoop
  340.  
  341. IF rLen& < 0 THEN  'Read error
  342.    loadError$ = "Read error"
  343.    GOTO Lcleanup
  344. END IF   
  345.  
  346. REM - rLen& = 0 means EOF
  347. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  348.    loadError$ = "Needed ILBM chunks not found"
  349.    GOTO Lcleanup
  350. END IF
  351.  
  352.  
  353. GoodLoad:
  354. loadError$ =""
  355.  
  356. REM  Load proper Colors
  357. IF foundCMAP THEN 
  358.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  359. END IF
  360.  
  361. Lcleanup:
  362. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  363. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  364.  
  365. RETURN
  366.  
  367.  
  368. GetScrAddrs:
  369. REM - Get addresses of screen structures
  370.    sWindow&   = WINDOW(7)
  371.    sScreen&   = PEEKL(sWindow& + 46)
  372.    sViewPort& = sScreen& + 44
  373.    sRastPort& = sScreen& + 84
  374.    sColorMap& = PEEKL(sViewPort& + 4)
  375.    colorTab&  = PEEKL(sColorMap& + 4)
  376.    sBitMap&   = PEEKL(sRastPort& + 4)
  377.  
  378.    REM - Get screen parameters
  379.    scrWidth%  = PEEKW(sScreen& + 12)
  380.    scrHeight% = PEEKW(sScreen& + 14)
  381.    scrDepth%  = PEEK(sBitMap& + 5)
  382.    nColors%   = 2^scrDepth%
  383.  
  384.    REM - Get addresses of Bit Planes 
  385.    FOR kk = 0 TO scrDepth% - 1
  386.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  387.    NEXT
  388. RETURN
  389.  
  390.  
  391.